home *** CD-ROM | disk | FTP | other *** search
/ The X-Philes (2nd Revision) / The X-Philes Number 1 (1995).iso / xphiles / hp95 / tpas5grf.doc < prev    next >
Text File  |  1995-03-31  |  7KB  |  274 lines

  1. Sent via Internet --- 
  2.  
  3.   Date:    Wed, 16 Oct 1991 14:51:53 CST 
  4.   From: SUNNERS@hfrd.dsto.oz.au (Mike Sunners) 
  5.     To: everett@hpcvra.cv.hp.com 
  6.  
  7. Sir, 
  8.     Thanks very much for the graphics documentation. 
  9.  
  10.     I have been running Turbo Pascal 5.0 on the 95LX. 
  11. I chose this language because it is small - ie 
  12. TPC.EXE    56925    (compiler) 
  13. TURBO.TPL  35632    (runtime system and dos lib) 
  14. EDIT.EXE   29696    (an editor) 
  15.  
  16.     The small size means that programs can be  
  17. written and debugged on the 95LX (although I also 
  18. have a PC). I do have Turbo C++, and TASM, but they 
  19. are too big to think about. 
  20.  
  21.     Accordingly, I rewrote the graphics interface 
  22. as a Pascal unit - see below. The source and  
  23. compiled version take up about 10Kbytes. I also 
  24. made a few changes for my own satisfaction, and may 
  25. do another rewrite later to clean up the interface. 
  26.  
  27. Thanks again, 
  28.              Mike Sunners 
  29.  
  30.  
  31. ----------- Cut here ------------------------------- 
  32. { HP 95LX Graphics Interface Unit for Turbo Pascal } 
  33. { Written by Mike Sunners, 16OCT91 } 
  34. { Original definition courtesy Everett Kaser, 
  35.   everett%hpcvra@hplabs.hp.com } 
  36. { Comments to sunners@hfrd.dsto.oz.au } 
  37.  
  38. { This unit is an adaptation of an interface library 
  39.   comprising an assembly language program and a C header 
  40.   file written by Everett Kaser. 
  41.  
  42.   These procedures/functions load a register record with 
  43.   parameters, and then use the Turbo Pascal Intr 
  44.   call to generate a software interrupt. 
  45.  
  46.   This interface is probably slower than the 
  47.   original C version, but has the advantage that 
  48.   a separate assembly language module is not required, 
  49.   and hence the unit can be compiled using only Turbo 
  50.   Pascal on the HP 95LX. 
  51.  
  52.   The image manipulation routines were modified slightly 
  53.   for this unit. The G_ImageGet function allocates 
  54.   heap space for the requested image, remembers the size 
  55.   allocated, and returns a pointer of type G_Image to this 
  56.   information. G_ImagePut displays the image as before. The 
  57.   space allocated to the image is returned by calling 
  58.   G_ImageDispose. } 
  59.  
  60. unit Graphics; 
  61. interface 
  62.  
  63. type G_Mask = array [0..7] of byte; 
  64.  
  65. type G_Info = 
  66.   record 
  67.     vidmode,defmode : byte; 
  68.     xpixels,ypixels : word; 
  69.     xloc,yloc : integer; 
  70.     linetype,rrule,colour : word; 
  71.     xclipmin,yclipmin : integer; 
  72.     xclipmax,yclipmax : integer; 
  73.     xlorg,ylorg : integer; 
  74.     fillmask : G_Mask; 
  75.   end; { G_Info } 
  76.  
  77. type G_ImageRec = 
  78.   record 
  79.     p : pointer; 
  80.     size : word; 
  81.   end; { G_ImageRec } 
  82.  
  83. type G_Image = ^G_ImageRec; 
  84.  
  85. procedure G_Mode(BiosVideoMode : byte); 
  86. procedure G_FillMask(mask : G_Mask); 
  87. procedure G_GetInfo(var info : G_Info); 
  88. procedure G_LorgA(x,y : integer); 
  89. procedure G_ClipL(xmin,ymin,xmax,ymax : integer); 
  90. procedure G_Rect(x,y : integer; fillflag : byte); 
  91. procedure G_Draw(x,y : integer); 
  92. procedure G_Point(x,y : integer); 
  93. procedure G_Move(x,y : integer); 
  94. procedure G_ColourSel(colour : byte); 
  95. procedure G_RepRule(rrule : byte); 
  96. procedure G_LineType(ltype : word); 
  97. function  G_PointRead(x,y : integer) : byte; 
  98. function  G_ImageGet(x1,y1,x2,y2 : integer) : G_Image; 
  99. procedure G_ImageDispose(image : G_Image); 
  100. procedure G_ImagePut(x,y : integer; image : G_Image; rrule : byte); 
  101. procedure G_Text(x,y : integer; s : string; rotflag : byte); 
  102.  
  103. implementation 
  104. uses dos; 
  105.  
  106. var rs : Registers; { Dos register set for software interrupt } 
  107.  
  108. type call_range = 0..15; { The range of software interrupts } 
  109.  
  110. procedure go(sw_int : call_range); { Generate an interrupt } 
  111. begin 
  112.   rs.ah := sw_int; 
  113.   Intr($5f,rs); 
  114. end; { go } 
  115.  
  116. procedure go_with_point(sw_int : call_range; x,y : integer); 
  117. { Load x and y parameters before generating an interrupt } 
  118. begin 
  119.   rs.cx := x; 
  120.   rs.dx := y; 
  121.   go(sw_int); 
  122. end; { go_with_point } 
  123.  
  124. procedure G_Mode(BiosVideoMode : byte); 
  125. begin 
  126.   rs.al := BiosVideoMode; 
  127.   go(0); 
  128. end; 
  129.  
  130. procedure G_FillMask(mask : G_Mask); 
  131. begin 
  132.   rs.es := Seg(mask); 
  133.   rs.di := Ofs(mask); 
  134.   go(1); 
  135. end; { G_FillMask } 
  136.  
  137. procedure G_GetInfo(var info : G_Info); 
  138. begin 
  139.   rs.es := Seg(info); 
  140.   rs.di := Ofs(info); 
  141.   go(2); 
  142. end; { G_GetInfo } 
  143.  
  144. procedure G_LorgA(x,y : integer); 
  145. begin 
  146.   go_with_point(3,x,y); 
  147. end; { G_LorgA } 
  148.  
  149. procedure G_ClipL(xmin,ymin,xmax,ymax : integer); 
  150. begin 
  151.   rs.si := xmax; 
  152.   rs.di := ymax; 
  153.   go_with_point(4,xmin,ymin); 
  154. end; { G_ClipL } 
  155.  
  156. procedure G_Rect(x,y : integer; fillflag : byte); 
  157. begin 
  158.   rs.al := fillflag; 
  159.   go_with_point(5,x,y); 
  160. end; 
  161.  
  162. procedure G_Draw(x,y : integer); 
  163. begin 
  164.   go_with_point(6,x,y); 
  165. end; { G_Draw } 
  166.  
  167. procedure G_Point(x,y : integer); 
  168. begin 
  169.   go_with_point(7,x,y); 
  170. end; { G_Point } 
  171.  
  172. procedure G_Move(x,y : integer); 
  173. begin 
  174.   go_with_point(8,x,y); 
  175. end; { G_Move } 
  176.  
  177. procedure G_ColourSel(colour : byte); 
  178. begin 
  179.   rs.al := colour; 
  180.   go(9); 
  181. end; { G_ColourSel } 
  182.  
  183. procedure G_RepRule(rrule : byte); 
  184. begin 
  185.   rs.al := rrule; 
  186.   go(10); 
  187. end; { G_RepRule } 
  188.  
  189. procedure G_LineType(ltype : word); 
  190. begin 
  191.   rs.cx := ltype; 
  192.   go(11); 
  193. end; { G_LineType } 
  194.  
  195. function G_PointRead(x,y : integer) : byte; 
  196. begin 
  197.   go_with_point(12,x,y); 
  198.   G_PointRead := rs.al; 
  199. end; { G_PointRead } 
  200.  
  201. function image_size(x1,y1,x2,y2 : integer) : word; 
  202. { Find the size required to store an image } 
  203. begin 
  204.   image_size := 8+((x2-x1+8) div 8)*(y2-y1+1); 
  205. end; { image_size } 
  206.  
  207. type coerce_ptr = 
  208.   record 
  209.     ofs,seg : word; 
  210.   end; 
  211.  
  212. function  G_ImageGet(x1,y1,x2,y2 : integer) : G_Image; 
  213. var image : G_Image; { returned image } 
  214. begin 
  215.   new(image); 
  216.   rs.si := x2; 
  217.   rs.bp := y2; 
  218.   image^.size := image_size(x1,y1,x2,y2); 
  219.   GetMem(image^.p,image^.size); { allocate image on the heap } 
  220.   rs.es := coerce_ptr(image^.p).seg; 
  221.   rs.di := coerce_ptr(image^.p).ofs; 
  222.   go_with_point(13,x1,y1); 
  223.   G_ImageGet := image; 
  224. end; { G_ImageGet } 
  225.  
  226. procedure G_ImageDispose(image : G_Image); 
  227. begin 
  228.   FreeMem(image^.p,image^.size); { dispose of the heap space } 
  229.   Dispose(image); { dispose of the users pointer to the image } 
  230. end; { G_ImageDispose } 
  231.  
  232. procedure G_ImagePut(x,y : integer; image : G_Image; rrule : byte); 
  233. begin 
  234.   rs.al := rrule; 
  235.   rs.es := coerce_ptr(image^.p).seg; 
  236.   rs.di := coerce_ptr(image^.p).ofs; 
  237.   go_with_point(14,x,y); 
  238. end; { G_Image_Put } 
  239.  
  240. procedure G_Text(x,y : integer; 
  241.                  s : string; 
  242.                  rotflag : byte); 
  243. type coerce_str = 
  244.   record 
  245.     len : byte; 
  246.     cStr : array [1..255] of char; 
  247.   end; 
  248. begin 
  249.  
  250.   { Zero terminate the (pascal) string so that 
  251.     it looks like a C string. If s is full, then 
  252.     there is no room for a zero byte, so report 
  253.     an error. } 
  254.  
  255.   if Length(s)=255 then 
  256.     s := 'G_Text: String too long'; 
  257.   with coerce_str(s) do 
  258.     begin 
  259.       cStr[len+1] := #0; 
  260.       rs.ah := 15; 
  261.       rs.al := rotflag; 
  262.       rs.es := Seg(cStr); 
  263.       rs.di := Ofs(cStr); 
  264.       go_with_point(15,x,y); 
  265.     end; { coercion } 
  266. end; { G_Text } 
  267.  
  268. end. 
  269. ----- Cut here ------------------------------------------------ 
  270. Mike Sunners              DSTO Surveillance Research Laboratory 
  271. sunners@hfrd.dsto.oz.au   Building 200 LABS HFRD 
  272. Phone: +61 8 259 7141     PO Box 1650 SALISBURY AUSTRALIA 5108 
  273.  
  274.